'Programm by TweakerRay
'Get the music for free at http://tweakerray.bandcamp.com

On Error Ignore ' Ignore Error when Controller is not connected

WII Classic Open 3 : Errorcode=mm.errno


dim xbait(10),ybait(10)
dim a$(20)
dim xygrid(97,49) ' cordinates if a 95 X 95 Grid -
                            ' if no barrier is set then it has the value 0

                            ' barrier is set it will have the value 1

                            ' if there is a heart it has the value 2

                            ' if there is a firebarrier it has the value 3

'rgb color define for easy color command and name of color
darkgray=rgb (80,80,80)
    gray=rgb (140,140,140)
   green=rgb (0,255,0)
     red=rgb (255,0,0)
lightred=rgb (255,100,100)
 darkred=rgb (100,0,0)
   white=rgb (255,255,255)
    blue=rgb (0,100,255)
  yellow=rgb (255,255,0)
  purple=rgb (255,0,255)

'This keys will be allowed to press - if another key is pressed it will be ignored and not stored
dim remkey(20)
remkey(1)=101 'e for ending the game
remkey(2)=128 'up
remkey(3)=129 'down
remkey(4)=130 'left
remkey(5)=131 'right
remkey(6)=145 'F1
remkey(7)=146 'F2
remkey(8)=98  'b for Bomb

dim remjoy(20)
remjoy(1)=32  'Down
remjoy(2)=64  'Right
remjoy(3)=128 'Up
remjoy(4)=256 'Left
remjoy(5)=8192 'Button b


firstrun=1 ' set to 1 to activate the help page if firstrun is 1 - if its 0 no helppage

start:
cls
mode 1

'setting the values for the case if you start after a "Game Over" again

keyremember=0 ' status if a key is remembered - if it has a 1 then the key will be stored to buffer$
Liv=5         ' your 5 starting Lives
bombcount=10  ' your 10 starting bombs
bonustime=0   ' if you manage to be faster the rest time will be bonus but set to 0 for start
buffer$=""    ' the buffer$ holds the last key pressed so the movement continues - cleared at start
countsound=10 ' this value goes from 10-1 for different check to play countdownsound
round=1       ' round is your Levelvalue - set to 1 at start
x=8         ' is the X pixelstartvalue of your char (a char is 8*12 pixel) so it starts on column 2
y=25         ' is the Y pixelstartvalue of your char (this will be the 3rd row)
baitcount=10  ' this is the start value of the hearts - 10 each round to get
smother=4     ' pausevalue between movement of the char -
              ' it moves through each pixel 8 left/right or 12 up/down
firecount=0   ' value of firewalls set at beginning

if firstrun=1 then helpscreen
timer=0 : starttime=35000       ' 35000 ms (35 Sec time to start
'The timer will be activated here to count up the seconds...

'Sub will generate Barriers
generatebarrier

'Sub will generate the hearts to be eaten as bait
generateheart

'95 * 45 grid - because of statusbar above and borders
'Xcord = from  8 - 760 Pixel
'Ycord = from 25 - 552 Pixel

do
xc=(x/8):yc=((y-1)/12)-1 'pixelvalue to simple cordinates (95 x 45 grid)

'timer calculation / Cint will round the value / the starttime - the timer will be the seconds
'you have left.

countdown=(cint(int(starttime-int(timer))/1000))+bonustime

'Gameover restrictions = if the countdown reaches 0 its Game Over !!!
                       ' if your lives are 0 then it's Game Over
if countdown=0 then gameover
if Liv=0 then gameover

'Show things on screen now...
printscreen:
color white

Print@(1,1)"Lives:";Liv;" "
Print@(80,1)"Bombs:";bombcount;" "
color gray:
Print@(304,1)chr$(219)
color white:
Print@(312,1)":";barriercount
color purple:
Print@(360,1)chr$(175)
color white:
Print@(368,1)":";barriercount
Print@(384,1);firecount
' Print@(75,1)"x:";x;" "
' Print@(135,1)"y:";y;" "
' if asc(ta$)<>0 then Print@(1,1)"X:";x;"  "
' if asc(ta$)<>0 then Print@(70,1)"Y:";y;"  "
' if asc(ta$)<>0 then Print@(150,1)"chr$:";asc(ta$)
Print@(180,1)"Hearts:";baitcount;"  ":color red: Print@(264,1);chr$(140):color white
' if asc(ta$)<>0 then Print@(350,1)"(";x/8;"  "
' if asc(ta$)<>0 then Print@(382,1)((y-1)/12)-1;")  "
' Print@(382,1);keyremember
Print@(432,1)"Level:";round
if countdown>35 then color green
if countdown<35 then color white
if countdown<11 then color red

Print@(600,1)"Timer:";countdown;" "

'Keycheck to move char

tastenabfrage:
keyremember=0

ta$=chr$(keydown(1))
ta2$=chr$(keydown(2))
button=classic(B,3) 'buttoncheck joypad

if button=0 then asc(ta$)=0
if button=128  then ta$=chr$(128)
if button=32   then ta$=chr$(129)
if button=256  then ta$=chr$(130)
if button=64   then ta$=chr$(131)
if button=8192 then ta$=chr$(98)

if asc(ta$)=0 then ta$=buffer$: ' if no key is pressed the old key which was pressed will be stored

if asc(ta$)<>0 then checkkey ' Sub to check remembered keys so no other key stops the movement.
if asc(ta$)<>0 then Print@(x,y);chr$(32) ' delete char from position when a key is pressed
if ta$=chr$(128) then moveup           'y=y-12:yr=12:xr=0 'Coursor up
if ta$=chr$(129) then movedown         'y=y+12:yr=-12:xr=0 'Coursor down
if ta$=chr$(130) then moveleft         'x=x-8:xr=+8:yr=0 'coursor left
if ta$=chr$(131) then moveright        'x=x+8:xr=-8:yr=0 'coursor right
if ta$=chr$(145) then generateheart 'F1 - Debug functions for generating hearts
if ta$=chr$(146) then round=round+1:timer=0 :generatebarrier  'F2 - debug functions to add more barriers
if ta$=chr$(98) then bombe ' if b is pressed you activate a bomb

buffer$=ta$ ' Store keypress to let char do the same move if next no key is pressed
if buffer$=chr$(145) then buffer$="" 'if f1 is pressed - key not to buffer$
if buffer$=chr$(146) then buffer$="" 'if f2 is pressed - key not to buffer$
if buffer$=chr$(98) then buffer$=buffer2$ ' if b is pressed it will be stored at buffer2$

'check if a heart is eaten at the xbait and ybait chordinates
for lv=1 to 10
if x=xbait(lv) and y=ybait(lv) then hearteaten
next

color yellow ' Print Char
Print @(x,y);chr$(135)

'countdown only ten Print then do a beep sound with different freq at last 5 sec
if countsound=10 and countdown=10 then play sound 2,B,q,800,10:countsound=countsound-1
if countsound=9 and countdown=9 then play sound 2,B,q,800,10:countsound=countsound-1
if countsound=8 and countdown=8 then play sound 2,B,q,800,10:countsound=countsound-1
if countsound=7 and countdown=7 then play sound 2,B,q,800,10:countsound=countsound-1
if countsound=6 and countdown=6 then play sound 2,B,q,800,10:countsound=countsound-1
if countsound=5 and countdown=5 then play sound 2,B,q,1200,10:countsound=countsound-1
if countsound=4 and countdown=4 then play sound 2,B,q,1300,10:countsound=countsound-1
if countsound=3 and countdown=3 then play sound 2,B,q,1400,10:countsound=countsound-1
if countsound=2 and countdown=2 then play sound 2,B,q,1500,10:countsound=countsound-1
if countsound=1 and countdown=1 then play sound 2,B,q,1600,10:countsound=countsound-1
pause 20
play stop


loop until ta$="e" ' if e is pressed programm ends...
end


'-------------------------------------------------------------------------------------'
sub generateheart
   baitcount=10
   color red
      for lv=1 to 10
         xbait(lv)=(int(rnd*95)+1)*8
         ybait(lv)=25+(int(rnd*45)*12)
         sbx=xbait(lv)/8
         sby=(ybait(lv)/12)
         xygrid(sbx,sby)=2 'Hearts overwrite the barrier status so if a star is over a barrier the barrier
                                      'status will be erased and set to 0 so you can eat the star

         Print @(xbait(lv),ybait(lv));chr$(32) 'clear space if maybe barrier before ?
         Print @(xbait(lv),ybait(lv));chr$(140)'draw a Heart
     next
  color darkred
  box 0,20,772,550,3 'Draw Border on Screen
end sub
'-------------------------------------------------------------------------------------'
sub generatebarrier
  barriercount=0
  cls
  'Generate 30 random Barrierposition (rbx/rby)
   for lv=1 to 30
        '95 X 45 Grid
         rbx=int(rnd*94)+1:if rbx<2 then rbx=2
         rby=int(rnd*45)+1:if rby<3 then rby=3

       ' chordinate stored to the xygrid field and set to 1 for Normal Barrier
      xygrid(rbx,rby)=1
  next Lv

      'Generate Firebarriers (count of Firebarriers are 1 and will add levelvalue new ones
      'So first level has 1 Fire barrier - Level 2 has 1 + 2 - Level 3 has 1 + 2 + 3 and so on.

  for lv=1 to round
     '95 X 45 Grid
      rbx=int(rnd*84)+10:
      rby=int(rnd*35)+10:
      firecount=firecount+1
      ' Chordinate stored to the xygrid field and set to 3 for Fire Barrier
      xygrid(rbx,rby)=3
  next Lv

'Draw Barriers & Fire Barriers
for yg=1 to 46
  for xg=1 to 95
    if xygrid(xg,yg)=1 then color gray: Print @(xg*8,yg*12);chr$(219):barriercount=barriercount+1
    if xygrid(xg,yg)=3 then color purple: Print @(xg*8,yg*12);chr$(175) 'Fire Barrier
  next xg
next yg

  color darkred
  box 0,20,772,550,3 ' Draw Borderwall
  'triggered if the round gets to 2 - do 10 more hearts
  if round>1 then generateheart
end sub
'-------------------------------------------------------------------------------------'

' if b is pressed the area around the char will explode and destroy the barriers.
' their position will be set to 0 on the xygrid

sub bombe
  color darkgray
  expl=103 'char to change for bombradius symbols
  freq=20
for lv2=1 to 40

  'do a bomb sound
  freq=freq+2
  play sound 1,B,N,freq,10
  pause 2

  '+3 y row over char
  if yc>3 then xygrid(xc,yc-2)=0:Print@(xc*8,(yc-2)*12);chr$(expl)
  if yc>3 and xc>1 then xygrid(xc-1,yc-2)=0:Print@((xc-1)*8,(yc-2)*12);chr$(expl)
  if yc>3 and xc<95 then xygrid(xc+1,yc-2)=0:Print@((xc+1)*8,(yc-2)*12);chr$(expl)
  if yc>3 and xc<94 then xygrid(xc+2,yc-2)=0:Print@((xc+2)*8,(yc-2)*12);chr$(expl)
  '+2 y row over char
  if yc>2 then xygrid(xc,yc-1)=0:Print@(xc*8,(yc-1)*12);chr$(expl)
  if yc>2 and xc>1 then xygrid(xc-1,yc-1)=0:Print@((xc-1)*8,(yc-1)*12);chr$(expl)
  if yc>2 and xc<95 then xygrid(xc+1,yc-1)=0:Print@((xc+1)*8,(yc-1)*12);chr$(expl)
  if yc>2 and xc<94 then xygrid(xc+2,yc-1)=0:Print@((xc+2)*8,(yc-1)*12);chr$(expl)
  if yc>2 and xc<93 then xygrid(xc+3,yc-1)=0:Print@((xc+3)*8,(yc-1)*12);chr$(expl)

  '+1 y row over char
  if yc>1 then xygrid(xc,yc)=0:Print@(xc*8,yc*12);chr$(expl)
  if yc>1 and xc>1 then xygrid(xc-1,yc)=0:Print@((xc-1)*8,yc*12);chr$(expl)
  if yc>1 and xc<95 then xygrid(xc+1,yc)=0:Print@((xc+1)*8,yc*12);chr$(expl)
  if yc>1 and xc<94 then xygrid(xc+2,yc)=0:Print@((xc+2)*8,yc*12);chr$(expl)
  if yc>1 and xc<93 then xygrid(xc+3,yc)=0:Print@((xc+3)*8,(yc)*12);chr$(expl)
  'row at same y pos as char
  if yc>0 then xygrid(xc,yc+1)=0:Print@(xc*8,(yc+1)*12);chr$(expl)
  if yc>0 and xc>1 then xygrid(xc-1,yc+1)=0:Print@((xc-1)*8,(yc+1)*12);chr$(expl)
  if yc>0 and xc<94 then xygrid(xc+1,yc+1)=0:Print@((xc+1)*8,(yc+1)*12);chr$(expl)
  if yc>0 and xc<93 then xygrid(xc+2,yc+1)=0:Print@((xc+2)*8,(yc+1)*12);chr$(expl)
  if yc>0 and xc<92 then xygrid(xc+3,yc+1)=0:Print@((xc+3)*8,(yc+1)*12);chr$(expl)

  if yc<45 then xygrid(xc,yc+2)=0:Print@(xc*8,(yc+2)*12);chr$(expl)
  if yc<45 and xc>1 then xygrid(xc-1,yc+2)=0:Print@((xc-1)*8,(yc+2)*12);chr$(expl)
  if yc<45 and xc<94 then xygrid(xc+1,yc+2)=0:Print@((xc+1)*8,(yc+2)*12);chr$(expl)
  if yc<45 and xc<93 then xygrid(xc+2,yc+2)=0:Print@((xc+2)*8,(yc+2)*12);chr$(expl)
  if yc<44 then xygrid(xc,yc+3)=0:Print@(xc*8,(yc+3)*12);chr$(expl)
  if yc<44 and xc>2 then xygrid(xc-1,yc+3)=0:Print@((xc-1)*8,(yc+3)*12);chr$(expl)
  if yc<44 and xc<94 then xygrid(xc+1,yc+3)=0:Print@((xc+1)*8,(yc+3)*12);chr$(expl)
  if yc<44 and xc<93 then xygrid(xc+2,yc+3)=0:Print@((xc+2)*8,(yc+3)*12);chr$(expl)

  if xc>2 then xygrid(xc-2,yc+1)=0:Print@((xc-2)*8,(yc+1)*12);chr$(expl)
  if xc>2 and yc>2 then xygrid(xc-2,yc)=0:Print@((xc-2)*8,(yc)*12);chr$(expl)
  if xc>2 and yc<1 then xygrid(xc-2,yc-1)=0:Print@((xc-2)*8,(yc-1)*12);chr$(expl)
  if xc>2 and yc<44 then xygrid(xc-2,yc+2)=0:Print@((xc-2)*8,(yc+2)*12);chr$(expl)
  if xc>2 and yc>2 then xygrid(xc-2,yc-1)=0:Print@((xc-2)*8,(yc-1)*12);chr$(expl)
  if xc<94 and yc<45 then xygrid(xc+3,yc+2)=0:Print@((xc+3)*8,(yc+2)*12);chr$(expl)

  expl=expl+1
next

'redraw hearts
color red
for lv=1 to 10
Print @(xbait(lv),ybait(lv));chr$(32) 'clear space if maybe barrier before?
Print @(xbait(lv),ybait(lv));chr$(140) 'draw a Heart
next

bombcount=bombcount-1 ' reduce bombvalue
if bombcount=0 then remkey(8)=0: end sub 'if you have no bombs the key will be ignored next
buffer$=buffer2$: 'Last movement from buffer$ will be stored into buffer2$
pause 100
starttime=starttime+1000 'give one second back because of the bomb so the countdown is not so much
                         ' reduced
end sub
'-------------------------------------------------------------------------------------'
'this is for a random movement selector for an enemy... but I couldnt manage to put in one that
'actually hit the char... correctly so Its not used... maybe in V2 ;-)

sub randomnumber
  vr=int(rnd*4)+1
  if vr=1 then m=1  : m2=0
  if vr=2 then m=0  : m2=1
  if vr=3 then m=-1 : m2=0
  if vr=4 then m=0  : m2=-1
  mov=0
end sub

'-------------------------------------------------------------------------------------'

'Check if a heart is eaten and do a sound
sub hearteaten
  Print @(x,y);chr$(135)
   xbait(lv)=0:ybait(lv)=0
  baitcount=baitcount-1
  play sound 1,B,q,500,10
  pause 20
  play sound 1,B,q,800,10
  pause 20
  play sound 1,B,q,1000,10
  pause 20
  play stop
  if baitcount=0 then
     round=round+1:timer=0:countsound=10:bonustime=countdown:nextlevelsound
  endif
end sub

'-------------------------------------------------------------------------------------'
'Movement routine - the char will scroll through all pixels and not just set to its next position.
'For each move up - down - left - right it will be checked if there is a fire or normal barrier

sub moveup ' y=y-12:yr=12:xr=0 'Coursor up
  if y=25 then buffer$=chr$(129):ta$=buffer$:bouncesound2 : exit sub
  yg=y/12
  xg=x/8
  if xygrid(xg,yg-1)=1 then buffer$=chr$(129):ta$=buffer$:bouncesound: exit sub
  if xygrid(xg,yg-1)=3 then loselife: exit sub

  'scroll from 1 to 12 pixels
  for lv=1 to 12
     color yellow ' Print Char
     Print @(x,y);chr$(135)
     pause smother
     Print @(x,y);chr$(32)
     y=y-1
  next
'Last movement will also be stored to buffer2$ from buffer$
buffer2$=buffer$
end sub
'-------------------------------------------------------------------------------------'

sub movedown ' y=y-12:yr=12:xr=0 'Coursor down
  if y=553 then buffer$=chr$(128):ta$=buffer$:bouncesound2: exit sub

  yg=y/12
  xg=x/8
  if xygrid(xg,yg+1)=1 then buffer$=chr$(128):ta$=buffer$:bouncesound: exit sub
  if xygrid(xg,yg+1)=3 then loselife: exit sub

  for lv=1 to 12
    color yellow ' Print Char
    Print @(x,y);chr$(135)
    pause smother
    Print @(x,y);chr$(32)
    y=y+1
  next
buffer2$=buffer$
end sub
'-------------------------------------------------------------------------------------'

sub moveleft ' x=x-8:xr=+8:yr=0 'coursor left
  if x=8 then buffer$=chr$(131):ta$=buffer$:bouncesound2: exit sub

  yg=y/12
  xg=x/8
  if xygrid(xg-1,yg)=1 then buffer$=chr$(131):ta$=buffer$:bouncesound: exit sub
  if xygrid(xg-1,yg)=3 then loselife: exit sub

  for lv=1 to 8
    color yellow ' Print Char
    Print @(x,y);chr$(135)
    pause smother
    Print @(x,y);chr$(32)
    x=x-1
  next
buffer2$=buffer$
end sub

'-------------------------------------------------------------------------------------'

sub moveright'x=x+8:xr=-8:yr=0 'coursor right
  if x=760 then buffer$=chr$(130):ta$=buffer$:bouncesound2: exit sub

  yg=y/12
  xg=x/8
  if xygrid(xg+1,yg)=1 then buffer$=chr$(130):ta$=buffer$:bouncesound: exit sub
  if xygrid(xg+1,yg)=3 then loselife: exit sub

  for lv=1 to 8
    color yellow ' Print Char
    Print @(x,y);chr$(135)
    pause smother
    Print @(x,y);chr$(32)
    x=x+1
  next
buffer2$=buffer$
end sub
'-------------------------------------------------------------------------------------'
sub loselife
  'A Firebarrier was hit and the player lose a life with this routine...
  'also do a sound to that.
  Liv=Liv-1
  for lv=1 to 20
    play sound 1,B,N,50+lv,10
    pause 10
  next
buffer$="":ta$=""
x=8
y=25
end sub
'-------------------------------------------------------------------------------------'
sub gameover
  'Player has no lives left so it's game over - or the countdown reached 0 so its game over too.
  cls
  color yellow
  box 0,20,772,550,3
  color red
  Print@(328,200)"GAME OVER !!!"
  Print@(248,224)"     You reached Level; ";Round
  Print@(248,248)"Press <Space> for another Round !"

  freq=1020
  for lv=1 to 1000 step 4
    freq=freq-4
    play sound 1,B,Q,freq,10
    pause 2
  next
  for lv=1 to 200
    play sound 1,B,N,20+lv,10
    pause 2
  next
  pause 300
  play stop

  tasteover:
  do
    ta$=chr$(keydown(1))
    loop until ta$=" "
    'reset barriers (Clean the xygrid and also show it while doing that ;-)
    color green
      for yg=2 to 45
        for xg=1 to 95

        Print@(xg*8,yg*12);chr$(219)
        xygrid(xg,yg)=0
       next xg
    next yg
  goto start
end sub
'-------------------------------------------------------------------------------------'
sub bouncesound
  'Soundeffect if you hit a barrier
  color green
  Print @(x,y);chr$(135)
  r1=int(rnd*10)+1
    for lv=40 to 1 step -1
      play sound 1,B,Q,100+lv*r1,10
      pause 2
    next
  play stop
end sub
'-------------------------------------------------------------------------------------'
sub bouncesound2
  'soundeffect if you hit the borderwalls
  color green
  Print @(x,y);chr$(135)
  for lv=1 to 20
    play sound 1,B,N,lv*6,10
    pause 5
  next lv
  play stop
end sub
'-------------------------------------------------------------------------------------'
sub nextlevelsound
  'soundeffect if you finish a level
  for lv=1 to 2
    play sound 1,B,Q,150,10
    pause 30
    play sound 1,B,Q,300,10
    pause 30
    play sound 1,B,Q,600,10
    pause 30
    play sound 1,B,Q,800,10
    pause 30
  next
  play stop
  ta$="":buffer$=""
  x=8:y=25:bombcount=bombcount+1
  generatebarrier
end sub
'-------------------------------------------------------------------------------------'
sub checkkey
'check for allowed keys on Keyboard
  for lv=1 to 8
    if asc(ta$)=remkey(lv) then keyremember=keyremember+1
  next lv
  if keyremember=0 then ta$=buffer$
end sub
'-------------------------------------------------------------------------------------'
sub helpscreen:
  'Helpscreentext
  cls
  play mp3 "05 TweakerRay - Code Breaker (Instrumental Version).mp3"
  color green
  Print
  Print
  Print
  Print"               H E A R T   A T T A C K   V1.2 by TwealerRay (www.tweakerray.de)"
  Print
  Print
  Print"  Here is a little Game called: Heartattack !!!";
  color red
  if errorcode>0 Then ?" No Controller Connected "
  if errorcode=0 Then ?" WII Controller Connected "
  color green
  Print
  Print
  Print"  You have to collect 10 Hearts: ";
  color red
  Print chr$(140);
  color green
  Print" in 35 seconds."
  Print
  Print"  The Hearts are randomly generated...
  Print
  Print"  Also there will be 30 Obstacles (Barriers) ";
  color gray
  Print chr$(219);
  color green
  Print" generated."
  Print
  Print"  Avoid the Fire Barriers: ";
  color purple
  Print chr$(175);
  color green
  Print" They will cost you a life... and you only have 5.
  Print
  Print"  Each round 30 more Barriers will be generated."
  Print
  Print"  If you hit a Barrier your movement will be reversed."
  Print
  Print"  If you manage to have some time left before the timer gets to zero,"
  Print
  Print"  the time will be added as bonus to your countdowntime. So be quick to generate more time."
  Print
  Print"  You move your Icon: ";
  color yellow
  Print chr$(135);
  color green
  Print" with the  <coursorkeys>."
  Print
  Print"  You can lay a BOMB with <B> this will destroy only the barriers..."
  Print
  Print"  You have 10 Bombs from the start - Each round you get another additional Bomb."
  Print
  Print"  Press <Space> on keyboard or <b> on Controller to start. "
  Print
  Print
  Print
  Print
  Print
  Print
  Print"  Music by: TweakerRay"
  Print
  Print"  Title: Codebreaker (Instrumental Version) [160 Kbit/s]"
  Print"  Song taken from the EP: Escaping Reality 01"
  Print"  Get the Full 320 KBit/s Mp3 Version for FREE at:"
  Print"  http://tweakerray.bandcamp.com"

  color darkred
  box 0,20,772,550,3
  for lvd=1 to 95
    color gray
    Print@(lvd*8,400)chr$(219)
  next
  tastehelp:
  m=2
  xd=8
  color yellow
  do
    xd=xd+m:
    if xd>759 then m=-2
    if xd<8 then m=2
    Print@(xd,388);chr$(135)
    pause 10
    Print@(xd,388);chr$(32)

    ta$=chr$(keydown(1))
    button=classic(B,3) 'buttoncheck joypad

    loop until ta$=" " or button=8192


    play stop
    firstrun=1
end sub